home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / gfabasic / gfa_fly / fenster.lst next >
Encoding:
File List  |  1994-09-22  |  45.3 KB  |  1,251 lines
  1. ' ------------------------------------------------------------------------------
  2. ' - 'Fliegende Dialoge' für GFA-BASIC 3.x                                      -
  3. ' -                                                                            -
  4. ' - von Gregor Duchalski, Baueracker 15a, D-44627 Herne                        -
  5. ' - eMail-Kontakt: Gregor_Duchalski@do.maus.ruhr.de                            -
  6. ' -                                                                            -
  7. ' - Version 4.9                                                                -
  8. ' - Fenster-Dialoge, last change 02.06.94                                      -
  9. ' ------------------------------------------------------------------------------
  10. ' Bitte vor dem Starten den INLINE in 'rsc_init'
  11. ' einlesen und den Pfad der RSC-Datei ändern.
  12. '
  13. $m40960
  14. RESERVE 40960                                     ! Nur im Interpreter!
  15. '
  16. rsc_init
  17. '
  18. IF @rsc_laden("D:\GFA_FLY4\GFA_FLY4.RSC",3,1,2,3) ! File$,Trees,Popup,Menu,Alert
  19.   main
  20. ENDIF
  21. '
  22. GEMSYS 109                                        ! Nur ab GEM 1.04!
  23. rsc_exit
  24. '
  25. > PROCEDURE main
  26.   LOCAL t&,evnt&,shift&,key&,mx&,my&,mb&,mc&
  27.   '
  28.   ~GRAF_MOUSE(0,0)                           ! Für den Compiler
  29.   ' Weil's im Interpreter schöner aussieht, für den Compiler bitte entfernen!
  30.   ~FORM_DIAL(3,deskx&,desky&,deskw&,deskh&,deskx&,desky&,deskw&,deskh&)
  31.   '
  32.   ~WIND_UPDATE(1)                            ! BEG_UPDATE
  33.   ~MENU_BAR(rsc_adr%(menu|),1)               ! Menü darstellen
  34.   ~WIND_UPDATE(0)                            ! END_UPDATE
  35.   '
  36.   REPEAT
  37.     evnt&=EVNT_MULTI(&X10011,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,mx&,my&,mb&,shift&,key&,mc&)
  38.     '
  39.     IF BTST(evnt&,4) AND MENU(1)=10          ! Message + MN_SELECTED
  40.       '
  41.       t&=MENU(4)                             ! Objektnummer des Menütitels
  42.       '
  43.       SELECT MENU(5)
  44.         '
  45.       CASE m_new|
  46.         neues_fenster                        ! ...neues Fenster
  47.         '
  48.       CASE m_quit|
  49.         evnt&=BSET(evnt&,0)                  ! ...Ende
  50.         '
  51.       CASE m_dialog|
  52.         test_dialog(0)                       ! ...Dialog
  53.         '
  54.       CASE m_fenster|
  55.         test_dialog(&X1)                     ! ...Fensterdialog
  56.         '
  57.       CASE m_fensterc|                       ! ...Fensterdialog mit Closer
  58.         test_dialog(&X111)
  59.         '
  60.       ENDSELECT
  61.       '
  62.       ~MENU_TNORMAL(rsc_adr%(rsc_menu&),t&,1)! Titel wieder normal
  63.       '
  64.     ELSE IF BTST(evnt&,4)                    ! Fenster-Message...
  65.       message_auswerten(MENU(1),MENU(2),MENU(3),MENU(4),MENU(5),MENU(6),MENU(7),MENU(8))
  66.     ENDIF
  67.     '
  68.   UNTIL BTST(evnt&,0)                        ! Bis Taste gedrückt
  69.   '
  70.   ~WIND_UPDATE(1)                            ! BEG_UPDATE
  71.   ~MENU_BAR(rsc_adr%(menu|),0)               ! Menü weg
  72.   ~WIND_UPDATE(0)                            ! END_UPDATE
  73.   '
  74. RETURN
  75. '
  76. > PROCEDURE test_dialog(flag%)
  77.   LOCAL rsc&,popup&
  78.   '
  79.   ' Durchführung des Beispieldialoges...
  80.   '
  81.   rsc_draw(flags|,flag%)
  82.   '
  83.   REPEAT
  84.     rsc&=@rsc_do(flags|,0,popup&)
  85.     '
  86.   UNTIL rsc&=ok| OR rsc&=abbruch| OR rsc&=rsc_ac_close&
  87.   '
  88.   OB_STATE(rsc_adr%(flags|),rsc&)=BCLR(OB_STATE(rsc_adr%(flags|),rsc&),0)
  89.   rsc_back(flags|)
  90.   '
  91. RETURN
  92. > PROCEDURE neues_fenster
  93.   LOCAL handle&,a%
  94.   '
  95.   ' Zur Demonstration ein Fenster öffnen. Keine Titelzeile, um den Problemen
  96.   ' mit der Garbage-Collection zumindest hier aus dem Weg zu gehen...
  97.   '
  98.   handle&=WIND_CREATE(&X101011,deskx&,desky&,deskw&,deskh&)
  99.   IF handle&>0
  100.     '
  101.     ~WIND_SET(handle&,2,INT(SWAP(wt%)),INT(wt%),0,0)    ! Titel setzen
  102.     '
  103.     ~WIND_OPEN(handle&,deskx&,desky&,deskw&/2,deskh&/2) ! Öffnen
  104.     '
  105.   ENDIF
  106.   '
  107. RETURN
  108. '
  109. > PROCEDURE message_auswerten(msg&,id&,len&,handle&,x&,y&,w&,h&)
  110.   '
  111.   ' Allgemeine Auswertung der Message-Events...
  112.   '
  113.   ~WIND_UPDATE(1)                               ! BEG_UPDATE
  114.   '
  115.   SELECT msg&
  116.   CASE 20                                       ! WM_REDRAW
  117.     redraw(handle&,x&,y&,w&,h&)
  118.     '
  119.   CASE 21                                       ! WM_TOPPED
  120.     ~WIND_SET(handle&,10,0,0,0,0)
  121.     '
  122.   CASE 22                                       ! WM_CLOSED
  123.     ~WIND_CLOSE(handle&)
  124.     ~WIND_DELETE(handle&)
  125.     '
  126.   CASE 27,28                                    ! WM_MOVED/WM_SIZED
  127.     ~WIND_SET(handle&,5,x&,y&,w&,h&)
  128.     '
  129.   ENDSELECT
  130.   '
  131.   ~WIND_UPDATE(0)                               ! END_UPDATE
  132.   '
  133. RETURN
  134. > PROCEDURE redraw(handle&,x&,y&,w&,h&)
  135.   LOCAL rx&,ry&,rb&,rh&
  136.   '
  137.   ' Redrawt ein Fenster...
  138.   '
  139.   DEFFILL 0
  140.   '
  141.   ~WIND_UPDATE(1)                         ! BEG_UPDATE
  142.   ~GRAF_MOUSE(256,0)                      ! Hidem
  143.   '
  144.   ~WIND_GET(handle&,11,rx&,ry&,rb&,rh&)   ! 1. Rechteck
  145.   '
  146.   REPEAT
  147.     '
  148.     IF RC_INTERSECT(x&,y&,w&,h&,rx&,ry&,rb&,rh&)
  149.       '
  150.       PBOX rx&,ry&,ADD(rx&,PRED(rb&)),ADD(ry&,PRED(rh&))
  151.       '
  152.     ENDIF
  153.     '
  154.     ~WIND_GET(handle&,12,rx&,ry&,rb&,rh&) ! Nächstes Rechteck
  155.   UNTIL rb&=0 AND rh&=0                   ! ...solange bis kein Redraw mehr nötig
  156.   '
  157.   ~GRAF_MOUSE(257,0)                      ! Showm
  158.   ~WIND_UPDATE(0)                         ! END_UPDATE
  159.   '
  160. RETURN
  161. ' ------------------------------------------------------------------------------
  162. > PROCEDURE rsc_init
  163.   LOCAL a&
  164.   '
  165.   ' Initialisiert die von den RSC-Routinen benötigten Variablen...
  166.   '
  167.   ap_id&=APPL_INIT()                         ! Applikations-ID
  168.   '
  169.   rsc_aes&=INT{{ADD(GB,4)}}                  ! AES-Version
  170.   rsc_mtsk!=INT{ADD({ADD(GB,4)},2)}<>1       ! Multitasking?
  171.   rsc_alert&=-1                              ! Noch keine fliegenden Alerts
  172.   '
  173.   CONTRL(6)=GRAF_HANDLE(wchar&,hchar&,a&,a&) ! AES-Handle, Zeichenbreite/Höhe
  174.   rsc_vh&=V_OPNVWK(1)                        ! Virt.Workst. für Flydials öffnen
  175.   IF rsc_vh&=0
  176.     rsc_vh&=V~H                              ! ...Fehler, dann eben die alte
  177.   ENDIF
  178.   CONTRL(6)=V~H
  179.   '
  180.   INTIN(0)=1
  181.   VDISYS 102,1,0
  182.   planes&=INTOUT(4)                          ! Bitplanes
  183.   '
  184.   ~WIND_GET(0,7,deskx&,desky&,deskw&,deskh&) ! Hintergrundfenster
  185.   ' ------------------------------------------------------ Inline vorbereiten
  186.   INLINE rsc_flyd%,2834
  187.   '
  188.   rsc_bitblt%=ADD(rsc_flyd%,INT{ADD(rsc_flyd%,16)})      ! BITBLT-Routine
  189.   rsc_obspec%=ADD(rsc_flyd%,INT{ADD(rsc_flyd%,18)})      ! OB_SPEC-Routine...
  190.   rsc_cookie%=ADD(rsc_flyd%,INT{ADD(rsc_flyd%,20)})      ! COOKIE-Routine...
  191.   '
  192.   {ADD(rsc_flyd%,22)}=ADD(GB,24)                         ! VDI-Parameterblock
  193.   INT{ADD(rsc_flyd%,26)}=rsc_vh&                         ! Virt. Workstation
  194.   INT{ADD(rsc_flyd%,28)}=wchar&                          ! Zeichenzellenbreite
  195.   INT{ADD(rsc_flyd%,30)}=hchar&                          ! Zeichenzellenhöhe
  196.   ' ------------------------------------------------------
  197.   ' Berechnet den Speicherbedarf einer Bitmap-Grafik...
  198.   DEFFN getsize(w&,h&)=SHL(SHR(ADD(MUL(MUL(SHR(ADD(w&,15),3),h&),planes&),255),8),8)
  199.   '
  200.   ' Gegenstück zur Prozedur rsc_text: Universelles Objekt-Text auslesen...
  201.   DEFFN rsc_text$(tree&,obj&)=CHAR{C:rsc_obspec%(L:rsc_adr%(tree&),obj&)}
  202.   '
  203. RETURN
  204. > PROCEDURE rsc_exit
  205.   '
  206.   CONTRL(6)=rsc_vh&
  207.   VDISYS 38,0,0                              ! vqt_attributes
  208.   IF ABS(INTOUT(0))<>1                       ! Anderer AES-Zeichensatz (MTOS)...
  209.     ~VST_UNLOAD_FONTS(0)                     ! ...freigeben
  210.   ENDIF
  211.   '
  212.   IF rsc_vh&<>V~H                            ! Flydial-Workstation freigeben...
  213.     ~V_CLSVWK()
  214.   ENDIF
  215.   '
  216.   ' Die folgenden Zeilen sind nur im Interpreter relevant und können im
  217.   ' Compilat wegfallen. Tip: Mit dem ERGO!pro-Präprozessor ausblenden.
  218.   '
  219.   ~RSRC_FREE()                               ! Resource entfernen
  220.   '
  221.   IF popup_back%
  222.     ~MFREE(popup_back%)                      ! Popup-Hintergrund freigeben
  223.   ENDIF
  224.   '
  225.   IF rsc_userblk%
  226.     ~MFREE(rsc_userblk%)                     ! Userblks freigeben
  227.   ENDIF
  228.   '
  229. RETURN
  230. '
  231. > FUNCTION rsc_laden(file$,trees&,popup&,menu&,alert&)
  232. $F%
  233. LOCAL tree&,obj&,font_h&,font_id&,color3d&,a%
  234. '
  235. ' Lädt die Resource und initialisiert einige globale Variablen...
  236. ' ------------------------------------------------------ RSC laden
  237. ' Wollen Sie das RSC-File direkt im Programmcode 'aufbewahren'?
  238. ' Dann entREMen Sie diese Zeilen und laden Sie die Funktion
  239. ' 'rsc_conv' aus EXTENDED.LST hinzu...
  240. ' INLINE rsc%,3160
  241. ' IF @rsrc_conv(rsc%)=0
  242. IF RSRC_LOAD(file$)=0
  243.   '
  244.   ~FORM_ALERT(1,"[3][ | Fehler beim Laden | der RSC-Datei! | ][Abbruch]")
  245.   RETURN FALSE
  246. ENDIF
  247. ' ------------------------------------------------------
  248. DIM rsc_adr%(trees&),rsc_handle%(trees&)
  249. DIM rscx&(trees&),rscy&(trees&),rscw&(trees&),rsch&(trees&)
  250. '
  251. rsc_trees&=trees&                                      ! Anzahl Objektbäume-1
  252. rsc_popup&=popup&                                      ! Popup-Baum
  253. rsc_menu&=menu&                                        ! Dropdown-Baum
  254. rsc_alert&=alert&                                      ! Alert-Baum
  255. ' ------------------------------------------------------
  256. ' Die folgenden Zeilen sind nur nötig, wenn das Resource-File ALERT-
  257. ' oder FREE-Bäume enthält. Näheres in der Doku.
  258. ' alerts&=trees&-SUCC(rsc_alert&)                        ! Alerts & Free Strings...
  259. ' FOR tree&=0 TO alerts&
  260. ' ~RSRC_GADDR(5,tree&,a%)
  261. ' rsc_adr%(rsc_alert&+SUCC(tree&))=a%
  262. ' NEXT tree&
  263. ' trees&=rsc_alert&
  264. ' ------------------------------------------------------ Adressen ermitteln
  265. FOR tree&=0 TO trees&
  266.   '
  267.   ~RSRC_GADDR(0,tree&,a%)  ! Kompatibel zu den XRSRC-Routinen
  268.   rsc_adr%(tree&)=a%
  269.   IF tree&<>menu&
  270.     ~FORM_CENTER(rsc_adr%(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  271.   ENDIF
  272.   '
  273. NEXT tree&
  274. ' ------------------------------------------------------ Größtes Popup
  275. IF popup&>-1
  276.   obj&=1
  277.   '
  278.   WHILE obj&>0
  279.     popup_back%=MAX(popup_back%,@getsize(ADD(OB_W(rsc_adr%(popup&),obj&),21),OB_H(rsc_adr%(popup&),obj&)))
  280.     obj&=OB_NEXT(rsc_adr%(popup&),obj&)
  281.   WEND
  282.   '
  283.   popup_back%=MALLOC(popup_back%)                      ! Hintergrundpuffer...
  284.   IF popup_back%=0
  285.     RETURN FALSE                                       ! ...nicht geklappt
  286.   ENDIF
  287.   '
  288. ENDIF
  289. ' ------------------------------------------------------ Anderer Zeichensatz
  290. IF rsc_aes&>=&H400 OR APPL_FIND("?API")=0              ! Hat APPL_GETINFO()...
  291.   '
  292.   GCONTRL(0)=130
  293.   GCONTRL(1)=1
  294.   GCONTRL(2)=5
  295.   GCONTRL(3)=0
  296.   GCONTRL(4)=0
  297.   GINTIN(0)=0
  298.   '
  299.   GEMSYS                                               ! APPL_GETINFO()
  300.   '
  301.   IF GINTOUT(0)=1                                      ! Hat geklappt...
  302.     font_h&=GINTOUT(1)                                 ! AES-Font Höhe
  303.     font_id&=GINTOUT(2)                                ! AES-Font ID
  304.     '
  305.     IF ABS(font_id&)<>1 AND GDOS?<>0                   ! Anderer AES-Font...
  306.       V~H=rsc_vh&
  307.       ~VST_LOAD_FONTS(0)                               ! ...Fonts laden
  308.       DEFTEXT ,,,,font_id&
  309.       DEFTEXT ,,,font_h&                               ! ...und einstellen
  310.       V~H=-1
  311.     ENDIF
  312.   ENDIF
  313. ENDIF
  314. ' ------------------------------------------------------ 3D-Darstellung
  315. IF rsc_aes&>=&H340                                     ! Ab AES 3.40...
  316.   GCONTRL(0)=48
  317.   GCONTRL(1)=4
  318.   GCONTRL(2)=3
  319.   GCONTRL(3)=0
  320.   GCONTRL(4)=0
  321.   '
  322.   GINTIN(0)=0                                          ! Inquire
  323.   GINTIN(1)=5                                          ! Background
  324.   '
  325.   GEMSYS                                               ! OBJC_SYSVAR()
  326.   '
  327.   IF GINTOUT(0)>0                                      ! Hat geklappt...
  328.     color3d&=GINTOUT(1)                                ! ...3D-Farbe
  329.   ENDIF
  330. ENDIF
  331. ' ------------------------------------------------------
  332. INT{ADD(rsc_flyd%,32)}=color3d&>0                      ! 3D-Darstellung an/aus
  333. INT{ADD(rsc_flyd%,34)}=color3d&                        ! 3D-Farbe
  334. ' ------------------------------------------------------
  335. IF @rsc_walk_tree(trees&)
  336.   rsc_zuweisungen(trees&)
  337.   RETURN TRUE                                          ! alles ok
  338. ENDIF
  339. '
  340. RETURN FALSE                                           ! Error!
  341. ENDFUNC
  342. > FUNCTION rsc_walk_tree(trees&)
  343. $F%
  344. LOCAL a&,b&,userblk&,tree&,obj&,a%
  345. '
  346. ' RSC-Baum durchgehen und userdefs installieren...
  347. '
  348. ' ------------------------------------------------------ Userdefs ermitteln
  349. FOR tree&=0 TO trees&
  350. '
  351. obj&=-1
  352. '
  353. REPEAT
  354.   '
  355.   INC obj&
  356.   '
  357.   a&=SHR&(OB_TYPE(rsc_adr%(tree&),obj&),8)           ! Es ist ein userdef...
  358.   ADD userblk&,-AND(a&>=17,a&<=22)
  359.   '
  360. UNTIL BTST(OB_FLAGS(rsc_adr%(tree&),obj&),5)         ! ...bis LAST_OBJ
  361. '
  362. NEXT tree&
  363. '
  364. rsc_userblk%=MALLOC(SHL(SUCC(userblk&),3))             ! Userblks(+1) anfordern (*8)
  365. IF rsc_userblk%=0                                      ! Zu wenig Speicher...
  366. RETURN FALSE                                         ! ...Error!
  367. ENDIF
  368. a%=rsc_userblk%                                        ! Merken
  369. ' ------------------------------------------------------ Objektbäume modifiz.
  370. FOR tree&=0 TO trees&
  371. '
  372. obj&=-1
  373. REPEAT
  374.   '
  375.   INC obj&
  376.   '
  377.   SELECT SHR&(OB_TYPE(rsc_adr%(tree&),obj&),8)       ! OB_TYPE
  378.     ' ------------------------------------------------ Flydial-Ecke...
  379.   CASE 17
  380.     rsc_instal_userdef(tree&,obj&,5)
  381.     ' ------------------------------------------------ Button/String...
  382.   CASE 18
  383.     '
  384.     a&=OB_FLAGS(rsc_adr%(tree&),obj&)                ! OB_FLAGS
  385.     b&=BYTE(OB_TYPE(rsc_adr%(tree&),obj&))           ! Alter OB_TYPE
  386.     '
  387.     IF BTST(a&,4)                                    ! Radiobutton...
  388.       rsc_instal_userdef(tree&,obj&,1)
  389.       '                                              ! BUTTON, nicht EXIT
  390.     ELSE IF b&=26 AND (NOT BTST(a&,2))               ! Checkbutton...
  391.       rsc_instal_userdef(tree&,obj&,2)
  392.       '
  393.     ELSE                                             ! Normale EXIT-Buttons...
  394.       '
  395.       IF b&<>28                                      ! Kein STRING...
  396.         a&=SUCC(-BTST(a&,1)-BTST(a&,2)-BTST(a&,6))
  397.         IF a&>1 !EXIT       DEFAULT    TOUCHEXIT
  398.           OB_X(rsc_adr%(tree&),obj&)=SUB(OB_X(rsc_adr%(tree&),obj&),a&)
  399.           OB_Y(rsc_adr%(tree&),obj&)=SUB(OB_Y(rsc_adr%(tree&),obj&),a&)
  400.           OB_W(rsc_adr%(tree&),obj&)=ADD(OB_W(rsc_adr%(tree&),obj&),ADD(a&,a&))
  401.           OB_H(rsc_adr%(tree&),obj&)=SUCC(ADD(OB_H(rsc_adr%(tree&),obj&),ADD(a&,a&)))
  402.         ENDIF                                        ! ...für Redraw größer
  403.       ENDIF
  404.       '
  405.       rsc_instal_userdef(tree&,obj&,6)
  406.       '
  407.     ENDIF
  408.     ' ------------------------------------------------ Unterstr. Text...
  409.   CASE 19
  410.     rsc_instal_userdef(tree&,obj&,4)
  411.     OB_FLAGS(rsc_adr%(tree&),obj&)=BSET(OB_FLAGS(rsc_adr%(tree&),obj&),13)
  412.     ' ...OB_FLAG 13 setzen, wird in 'rsc_draw' benötigt
  413.     ' ------------------------------------------------ Rahmen...
  414.   CASE 20
  415.     rsc_instal_userdef(tree&,obj&,3)
  416.     ' ------------------------------------------------ Niceline...
  417.   CASE 21
  418.     rsc_instal_userdef(tree&,obj&,8)
  419.     ' ------------------------------------------------ Circlebutton...
  420.   CASE 22
  421.     IF hchar&=8 OR hchar&=16                         ! ...nur wenn möglich
  422.       rsc_instal_userdef(tree&,obj&,7)               ! ...als Bitmap
  423.     ELSE
  424.       OB_TYPE(rsc_adr%(tree&),obj&)=OR(SHL&(27,8),BYTE(OB_TYPE(rsc_adr%(tree&),obj&)))
  425.     ENDIF                                            ! ...sonst Pfeil lassen
  426.     '
  427.   ENDSELECT
  428.   '
  429. UNTIL BTST(OB_FLAGS(rsc_adr%(tree&),obj&),5)         ! Bis LAST_OB gesetzt
  430. '
  431. NEXT tree&
  432. '
  433. {rsc_userblk%}=0                                       ! Für Nullstrings
  434. rsc_userblk%=a%                                        ! Für MFREE() am Ende
  435. '
  436. RETURN TRUE                                            ! Alles OK
  437. ENDFUNC
  438. > PROCEDURE rsc_instal_userdef(tree&,obj&,nr&)
  439. '
  440. ' Userdef-Objekt installieren...
  441. '
  442. ' nr& bezeichnet eine der folgenden Ausgaberoutinen:
  443. ' 1  Radiobutton, rund
  444. ' 2  Check-Button
  445. ' 3  Rahmen
  446. ' 4  Unterstr. Text
  447. ' 5  Flydial
  448. ' 6  Button
  449. ' 7  Circlebutton
  450. ' 8  Niceline
  451. '
  452. {rsc_userblk%}=ADD(rsc_flyd%,INT{ADD(rsc_flyd%,SHL(PRED(nr&),1))})
  453. {ADD(rsc_userblk%,4)}=OB_SPEC(rsc_adr%(tree&),obj&)
  454. '
  455. OB_SPEC(rsc_adr%(tree&),obj&)=rsc_userblk%             ! userdef und alter Typ
  456. OB_TYPE(rsc_adr%(tree&),obj&)=OR(SHL&(BYTE(OB_TYPE(rsc_adr%(tree&),obj&)),8),24)
  457. '                                                      ! im oberen Byte
  458. ADD rsc_userblk%,8
  459. '
  460. RETURN
  461. '
  462. > PROCEDURE rsc_draw(tree&,flag%)
  463. LOCAL fly&,title&,obj&,x&,y&,w&,h&,rx&,ry&,rb&,rh&,handle&,a%,rsc_adr%
  464. '
  465. ' Stellt einen Dialog auf dem Bildschirm dar...
  466. '
  467. ' tree&   : Index des Dialogbaumes
  468. ' flag%   : Bitbelegung
  469. '           Bit 0 -> Fensterdialog
  470. '           Bit 1 -> Schließfeld
  471. '           Bit 2 -> Bei Fensterdialogen: Sofort zeichnen
  472. '
  473. rsc_adr%=rsc_adr%(tree&)
  474. ' --------------------------------------------------- Titel & Flugecke suchen
  475. DO WHILE NOT (fly&>0 AND title&>0)
  476. INC obj&
  477. IF BTST(OB_STATE(rsc_adr%,obj&),1)                ! Flugecke...
  478.   fly&=obj&
  479. ELSE IF BTST(OB_FLAGS(rsc_adr%,obj&),13)          ! Dialogtitel...
  480.   title&=obj&
  481. ENDIF
  482. LOOP UNTIL BTST(OB_FLAGS(rsc_adr%,obj&),5)
  483. ' --------------------------------------------------- Als Fenster-Dialog
  484. IF BTST(flag%,0)
  485. x&=SUCC(rscx&(tree&))
  486. y&=ADD(ADD(rscy&(tree&),SHL(hchar&,1)),5)
  487. w&=SUB(rscw&(tree&),2)
  488. h&=SUB(SUB(rsch&(tree&),SHL(hchar&,1)),5)
  489. '
  490. IF fly&                                           ! Flugecke hidden...
  491.   OB_FLAGS(rsc_adr%,fly&)=BSET(OB_FLAGS(rsc_adr%,fly&),7)
  492. ENDIF
  493. '                                                 ! Rahmen: 1 Pixel außen...
  494. OB_SPEC(rsc_adr%,0)=AND(OB_SPEC(rsc_adr%,0),&X11111111000000001111111111111111)
  495. '
  496. rx&=OR(&X1001,SHL(-BTST(flag%,1),1))              ! Ggf. Schließfeld
  497. handle&=WIND_CREATE(rx&,deskx&,desky&,deskw&,deskh&)
  498. IF handle&>0                                      ! Fenster vorhanden...
  499.   '
  500.   ~WIND_UPDATE(1)                                 ! BEG_UPDATE
  501.   '
  502.   INC rsc_window&                                 ! Anz. offene Fenster+1
  503.   rsc_menu_ienable(FALSE)                         ! Menütitel disablen
  504.   '
  505.   IF title&                                       ! Dialogtitel existiert...
  506.     a%=C:rsc_obspec%(L:rsc_adr%,title&)           ! ...Adresse des Titels
  507.   ELSE
  508.     a%=rsc_userblk%                               ! ...sonst Nullstring
  509.   ENDIF
  510.   ~WIND_SET(handle&,2,INT(SWAP(a%)),INT(a%),0,0)  ! Fenstertitel setzen
  511.   '
  512.   ~WIND_CALC(0,&X1001,x&,y&,w&,h&,rx&,ry&,rb&,rh&)! WC_BORDER
  513.   ~WIND_OPEN(handle&,rx&,ry&,rb&,rh&)
  514.   '
  515.   rsc_handle%(tree&)=handle&
  516.   '
  517.   IF BTST(flag%,2)                                ! Sofort zeichnen...
  518.     rsc_message(tree&,20,x&,y&,w&,h&,0,0)         ! ...redrawen
  519.     REPEAT
  520.       obj&=EVNT_MULTI(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1000)
  521.       IF BTST(obj&,4) AND (MENU(4)<>rsc_handle%(tree&))
  522.         message_auswerten(MENU(1),MENU(2),MENU(3),MENU(4),MENU(5),MENU(6),MENU(7),MENU(8))
  523.       ENDIF
  524.     UNTIL BTST(obj&,5)                            ! ...bis Timer-Event
  525.   ENDIF
  526.   '
  527.   ~WIND_UPDATE(0)                                 ! END_UPDATE
  528.   '
  529. ENDIF
  530. ENDIF
  531. ' --------------------------------------------------- Als normaler Dialog
  532. IF rsc_handle%(tree&)=0
  533. a%=AND(OB_SPEC(rsc_adr%,0),&X11111111000000001111111111111111)
  534. OB_SPEC(rsc_adr%,0)=OR(a%,SHL(2,16))              ! Rahmen: 2 Pixel innen
  535. '
  536. w&=rscw&(tree&)
  537. h&=rsch&(tree&)
  538. '                                                 ! Außerhalb des Screens...
  539. IF rscy&(tree&)<desky& OR ADD(rscx&(tree&),PRED(w&))>ADD(deskx&,PRED(deskw&)) OR ADD(rscy&(tree&),PRED(h&))>ADD(desky&,PRED(deskh&))
  540.   ~FORM_CENTER(rsc_adr%(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  541. ENDIF                                             ! ...wieder in die Mitte
  542. '
  543. ~WIND_UPDATE(1)                                   ! BEG_UPDATE
  544. '
  545. rsc_list$=rsc_list$+MKI$(tree&)                   ! Dialog in die Liste aufnehmen
  546. '
  547. rsc_handle%(tree&)=MALLOC(@getsize(w&,h&))
  548. IF rsc_handle%(tree&)                             ! Hintergrund retten...
  549.   rsc_bitblt(0,0,0,rsc_handle%(tree&),w&,h&,rscx&(tree&),rscy&(tree&),w&,h&,0,0)
  550.   '
  551. ENDIF
  552. '
  553. IF fly&>0 AND rsc_handle%(tree&)>0               ! Flugecke sichtbar...
  554.   OB_FLAGS(rsc_adr%,fly&)=BCLR(OB_FLAGS(rsc_adr%,fly&),7)
  555. ELSE IF fly&                                     ! unsichtbar...
  556.   OB_FLAGS(rsc_adr%,fly&)=BSET(OB_FLAGS(rsc_adr%,fly&),7)
  557. ENDIF
  558. '                                                ! Zeichnen...
  559. ~OBJC_DRAW(rsc_adr%,0,7,rscx&(tree&),rscy&(tree&),w&,h&)
  560. '
  561. ENDIF
  562. '
  563. RETURN
  564. > PROCEDURE rsc_menu_ienable(stat!)
  565. LOCAL obj&,title&,rsc_adr%
  566. '
  567. ' Disabled/enabled alle Menü-Titel und den 'About...'-Menü-Eintrag...
  568. '                                ! Gibt es ein Menü..
  569. IF rsc_menu&>-1 AND rsc_window&=1! und ist es das 1. Fenster?
  570. '
  571. rsc_adr%=rsc_adr%(rsc_menu&)
  572. '                              ! Objektbreite verändern...
  573. IF stat!                       ! Enablen...
  574.   OB_W(rsc_adr%,2)=rscw&(rsc_menu&)
  575. ELSE                           ! Disablen...
  576.   rscw&(rsc_menu&)=OB_W(rsc_adr%,2)
  577.   OB_W(rsc_adr%,2)=OB_W(rsc_adr%,3)
  578. ENDIF
  579. '
  580. obj&=3                         ! Ersten Menütitel überspringen
  581. '
  582. REPEAT
  583.   INC obj&
  584.   '                            ! G_TITEL...
  585.   IF BYTE(OB_TYPE(rsc_adr%,obj&))=32
  586.     '
  587.     ~MENU_IENABLE(rsc_adr%,obj&,stat!)
  588.     '
  589.     title&=obj&                ! Wird für 'About...' gebraucht
  590.   ENDIF
  591.   '
  592. UNTIL BTST(OB_FLAGS(rsc_adr%,obj&),5)
  593. '                              ! 'About...' dis/enablen
  594. ~MENU_IENABLE(rsc_adr%,ADD(title&,3),stat!)
  595. '                              ! Unter MultiTOS...
  596. IF (rsc_aes&>=&H400) AND rsc_mtsk!
  597.   IF ap_id&=MENU_BAR(rsc_adr%,-1)
  598.     ~MENU_BAR(rsc_adr%,1)      ! ...Menu nur neu anzeigen, wenn erlaubt
  599.   ENDIF
  600. ELSE                           ! Unter SingleTOS...
  601.   ~MENU_BAR(rsc_adr%,1)        ! ...Menu immer neu anzeigen
  602. ENDIF
  603. '
  604. ENDIF
  605. '
  606. RETURN
  607. '
  608. > FUNCTION rsc_do(tree&,next_obj&,VAR popup&)
  609. $F%
  610. LOCAL a&,handle&,a$
  611. LOCAL edit_obj&,cont&,ob_tail&,obj&,idx&,flags&,rsc_adr%,keytab%
  612. LOCAL ascii|,scan|,evnt&,mx&,my&,mb&,mc&,shift&,key&
  613. '
  614. ' Dialog auswerten...
  615. '
  616. IF rsc_handle%(tree&)>1000                             ! Normaler Dialog...
  617. ~WIND_UPDATE(1)                                      ! ...BEG_UPDATE
  618. ~WIND_UPDATE(3)                                      ! ...BEG_MCTRL
  619. flags&=&X11                                          ! ...BUTTON/KEYBD-Events
  620. '
  621. ELSE                                                   ! Fenster-Dialog...
  622. flags&=&X10011                                       ! ...zus. MESSAGE-Events
  623. ENDIF
  624. '
  625. rsc_adr%=rsc_adr%(tree&)
  626. cont&=TRUE
  627. ' ------------------------------------------------------ Editierbares Objekt
  628. DO WHILE (NOT BTST(OB_FLAGS(rsc_adr%,next_obj&),3)) OR BTST(OB_STATE(rsc_adr%,next_obj&),3)
  629. INC next_obj&
  630. LOOP UNTIL BTST(OB_FLAGS(rsc_adr%,next_obj&),5)
  631. IF BTST(OB_FLAGS(rsc_adr%,next_obj&),5) AND (NOT BTST(OB_FLAGS(rsc_adr%,next_obj&),3))
  632. next_obj&=0
  633. ENDIF
  634. ' ------------------------------------------------------
  635. WHILE cont&
  636. '
  637. IF next_obj&<>0 AND edit_obj&<>next_obj&             ! Ggf. Cursor setzen...
  638. edit_obj&=next_obj&                                ! ...Exit-Code zurück
  639. next_obj&=0                                        ! ...'rsc_do' verlassen
  640. ~OBJC_EDIT(rsc_adr%,edit_obj&,0,idx&,1,idx&)       ! ...Cursor ein
  641. ENDIF
  642. '
  643. evnt&=EVNT_MULTI(flags&,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,mx&,my&,mb&,shift&,key&,mc&)
  644. ' ---------------------------------------------------- Message-Ereignis
  645. IF BTST(evnt&,4)
  646. handle&=MENU(4)                                    ! ...Fenster-Handle
  647. '
  648. FOR a&=rsc_trees& DOWNTO 0                         ! Ist es ein RSC?...
  649.   EXIT IF handle&=rsc_handle%(a&)
  650. NEXT a&
  651. '
  652. IF MENU(1)=41 OR (MENU(1)=22 AND tree&=a&)         ! AC_CLOSE/Closer...
  653.   MUL rsc_window&,-(MENU(1)=22)
  654.   next_obj&=rsc_ac_close&                          ! ...Exit-Code
  655.   GOTO rsc_do_ende                                 ! ...rsc_do verlassen
  656.   '
  657. ELSE IF a&>-1 AND NOT (MENU(1)=21 AND a&<>tree&)   ! Ein RSC-Fenster....
  658.   rsc_message(a&,MENU(1),MENU(5),MENU(6),MENU(7),MENU(8),edit_obj&,idx&)
  659.   '
  660. ELSE IF MENU(1)=40 OR MENU(1)=21                   ! AC_OPEN/Anderes Fenster toppen...
  661.   rsc_message(tree&,21,MENU(5),MENU(6),MENU(7),MENU(8),edit_obj&,idx&)
  662.   '
  663. ELSE IF MENU(1)<>21 AND MENU(1)<>22                ! nicht toppen/schließen...
  664.   message_auswerten(MENU(1),MENU(2),MENU(3),MENU(4),MENU(5),MENU(6),MENU(7),MENU(8))
  665. ELSE                                               ! Nichts zu machen...
  666.   ~BIOS(3,2,7)
  667. ENDIF
  668. ENDIF
  669. ' ---------------------------------------------------- Tastaturereignis
  670. IF BTST(evnt&,0)
  671. '
  672. cont&=FORM_KEYBD(rsc_adr%,edit_obj&,key&,0,next_obj&,key&)
  673. ' Möchten Sie erweiterte Tastaturkommandos? Dann entREMen Sie
  674. ' diese Zeile und ersetzen die Prozedur durch:
  675. ' cont&=@form_keybd(rsc_adr%,edit_obj&,key&,0,next_obj&,key&,idx&)
  676. '
  677. ascii|=BYTE(key&)                                  ! ASCII-Code
  678. scan|=BYTE(SHR(key&,8))                            ! SCAN-Code
  679. '
  680. IF ascii|=0                                        ! Kein ASCII-Code...
  681.   '
  682.   IF scan|=97 OR scan|=98                          ! UNDO/HELP...
  683.     ascii|=ADD(SUB(scan|,97),14)
  684.     obj&=0
  685.     DO WHILE BTST(OB_FLAGS(rsc_adr%,obj&),5)=FALSE
  686.       INC obj&
  687.     LOOP UNTIL BTST(OB_FLAGS(rsc_adr%,obj&),ascii|)
  688.     IF BTST(OB_FLAGS(rsc_adr%,obj&),ascii|)
  689.       cont&=FORM_BUTTON(rsc_adr%,obj&,1,next_obj&)
  690.     ENDIF
  691.     '
  692.   ELSE IF scan|>=59 AND scan|<=68                  ! F-Tasten...
  693.     ascii|=SUB(scan|,58)
  694.     obj&=0
  695.     DO WHILE BTST(OB_FLAGS(rsc_adr%,obj&),5)=FALSE
  696.       INC obj&
  697.     LOOP UNTIL SHR&(OB_STATE(rsc_adr%,obj&),12)=ascii|
  698.     IF SHR&(OB_STATE(rsc_adr%,obj&),12)=ascii|
  699.       cont&=FORM_BUTTON(rsc_adr%,obj&,1,next_obj&)
  700.     ENDIF
  701.     '
  702.   ELSE                                             ! ALT+Buchstabe...
  703.     '
  704.     IF scan|>=120 AND scan|<=129                   ! Zahlen...
  705.       SUB scan|,118
  706.       keytab%={XBIOS(16,L:-1,L:-1,L:-1)}           ! ...ohne Shift
  707.     ELSE                                           ! Alles andere...
  708.       keytab%={ADD(XBIOS(16,L:-1,L:-1,L:-1),4)}    ! ...mit Shift
  709.     ENDIF
  710.     '
  711.     ascii|=BYTE{ADD(keytab%,scan|)}                ! ASCII-Code holen
  712.     '
  713.     IF ascii|                                      ! Tastaturbedienbar...
  714.       CLR a&,obj&
  715.       '
  716.       DO WHILE NOT BTST(OB_FLAGS(rsc_adr%,obj&),5) ! Nicht LASTOBJ
  717.         INC obj&
  718.         '
  719.         scan|=BYTE(SHR(OB_TYPE(rsc_adr%,obj&),8))
  720.         IF scan|=26 OR scan|=28                    ! Ein Button/String...
  721.           a$=@rsc_text$(tree&,obj&)                ! ...Text
  722.           '
  723.           a&=INSTR(a$,"[")
  724.           IF a&                                    ! Tastaturbedienbar...
  725.             a&=ASC(MID$(a$,SUCC(a&),1))
  726.             a&=(BCLR(a&,5)=ascii|) OR (a&>=48 AND a&<=57 AND a&=ascii|)
  727.           ENDIF
  728.           '                                        ! '[' vor Zeichen
  729.         ENDIF
  730.         '
  731.       LOOP UNTIL a&                                ! ...gefunden
  732.       '
  733.       IF a&                                        ! Objekt gefunden...
  734.         key&=0                                     ! ...keine Eingabe mehr
  735.         '                                          ! +SHIFT Circle-Butt?
  736.         IF BTST(shift&,1) AND BTST(OB_FLAGS(rsc_adr%,obj&),6) AND BTST(OB_STATE(rsc_adr%,SUCC(obj&)),5) AND SHR(OB_TYPE(rsc_adr%,obj&+2),8)=27
  737.           evnt&=BSET(evnt&,1)
  738.           mb&=1                                    ! ...Mausklick simulieren
  739.           ~OBJC_OFFSET(rsc_adr%,obj&+2,mx&,my&)
  740.           '                                        ! Ist es ein Popup...
  741.         ELSE IF BTST(OB_FLAGS(rsc_adr%,obj&),6) AND BTST(OB_STATE(rsc_adr%,SUCC(obj&)),5)
  742.           evnt&=BSET(evnt&,1)
  743.           mb&=1                                    ! ...Mausklick simul.
  744.           ~OBJC_OFFSET(rsc_adr%,obj&,mx&,my&)
  745.           '
  746.         ELSE                                       ! ...Button bedienen
  747.           cont&=FORM_BUTTON(rsc_adr%,obj&,1,next_obj&)
  748.         ENDIF
  749.       ENDIF
  750.       '
  751.     ENDIF
  752.   ENDIF
  753.   '
  754. ENDIF
  755. '
  756. IF key&
  757.   ~OBJC_EDIT(rsc_adr%,edit_obj&,key&,idx&,2,idx&)  ! ...Eingabe
  758. ENDIF
  759. '
  760. ENDIF
  761. ' ---------------------------------------------------- Mausereignis
  762. IF BTST(evnt&,1) AND mb&=1
  763. '                                                  ! Objekt unter Maus..
  764. next_obj&=OBJC_FIND(rsc_adr%,0,100,mx&,my&)
  765. '                                                  ! String vor Popup...
  766. IF next_obj&>0
  767.   IF BTST(OB_FLAGS(rsc_adr%,next_obj&),6) AND SHR(OB_TYPE(rsc_adr%,next_obj&),8)=28 AND BTST(OB_STATE(rsc_adr%,SUCC(next_obj&)),5)
  768.     ' (TOUCHEXIT, STRING, SUCC: SHADOWED)
  769.     INC next_obj&
  770.   ENDIF
  771. ENDIF
  772. '
  773. IF next_obj&=-1                                    ! Neben die Box...
  774.   ~BIOS(3,2,7)                                     ! ...PING!
  775.   next_obj&=0
  776.   '
  777. ELSE
  778.   cont&=FORM_BUTTON(rsc_adr%,next_obj&,1,next_obj&)
  779.   ' ------------------------------------------------ Flydial-Ecke
  780.   IF BTST(OB_STATE(rsc_adr%,next_obj&),1)          ! (CROSSED)
  781.     rsc_movedial(tree&,edit_obj&,idx&)             ! ...Dialog verschieben
  782.     '
  783.     next_obj&=0                                    ! Damit der Cursor..
  784.     cont&=1                                        ! ..bleibt wo er ist
  785.     ' ---------------------------------------------- Circle-Button...
  786.   ELSE IF SHR(OB_TYPE(rsc_adr%,next_obj&),8)=27 AND BTST(OB_STATE(rsc_adr%,MAX(0,PRED(next_obj&))),5) AND (NOT BTST(OB_STATE(rsc_adr%,MAX(0,PRED(next_obj&))),3))
  787.     ' (G_BOXCHAR, PRED: SHADOWED /NOT DISABLED)
  788.     next_obj&=PRED(next_obj&)                      ! Objektnr. Button
  789.     a$=@rsc_text$(tree&,next_obj&)                 ! Text des Buttons
  790.     evnt&=SHR&(OB_TYPE(rsc_adr%,next_obj&),8)-30   ! Nr. des Popup-Baumes
  791.     '
  792.     obj&=1
  793.     FOR ob_tail&=1 TO PRED(evnt&)
  794.       obj&=OB_NEXT(rsc_adr%(rsc_popup&),obj&)      ! Objektnr. des Popups
  795.     NEXT ob_tail&
  796.     '
  797.     evnt&=SUCC(obj&)
  798.     DO WHILE a$<>@rsc_text$(rsc_popup&,evnt&)
  799.       INC evnt&                                    ! Defaulteintrag
  800.     LOOP
  801.     '
  802.     REPEAT
  803.       INC evnt&                                    ! Nächster Eintrag...
  804.       IF evnt&>OB_TAIL(rsc_adr%(rsc_popup&),obj&)  ! ...gibt es nicht
  805.         evnt&=SUCC(obj&)                           ! ...dann wieder 1.
  806.       ENDIF
  807.       '                                            ! bis nicht DISABLED
  808.     UNTIL NOT BTST(OB_STATE(rsc_adr%(rsc_popup&),evnt&),3)
  809.     '                                              ! Button ändern...
  810.     rsc_text(tree&,next_obj&,@rsc_text$(rsc_popup&,evnt&))
  811.     ~OBJC_DRAW(rsc_adr%,next_obj&,1,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  812.     popup&=SUB(evnt&,obj&)
  813.     ' ---------------------------------------------- Popup-Menue...
  814.   ELSE IF BTST(OB_STATE(rsc_adr%,next_obj&),5) AND BTST(OB_FLAGS(rsc_adr%,next_obj&),6) AND (NOT BTST(OB_STATE(rsc_adr%,next_obj&),3))
  815.     ' (SHADOWED, TOUCHEXIT, NOT DISABLED)
  816.     evnt&=SHR&(OB_TYPE(rsc_adr%,next_obj&),8)-30   ! Nr. des Popup-Baumes
  817.     obj&=1
  818.     FOR ob_tail&=1 TO PRED(evnt&)
  819.       obj&=OB_NEXT(rsc_adr%(rsc_popup&),obj&)      ! Objektnr. des Popups
  820.     NEXT ob_tail&
  821.     '
  822.     ob_tail&=OB_TAIL(rsc_adr%(rsc_popup&),obj&)
  823.     a$=@rsc_text$(tree&,next_obj&)                 ! Text des Buttons
  824.     '
  825.     evnt&=SUCC(obj&)
  826.     DO WHILE a$<>@rsc_text$(rsc_popup&,evnt&)
  827.       INC evnt&                                    ! Ausrichtung ermitteln
  828.     LOOP UNTIL evnt&>ob_tail&
  829.     '
  830.     IF evnt&<=ob_tail&                             ! Defaulteintrag...
  831.       popup&=@rsc_popup(TRUE,tree&,next_obj&,obj&,SUB(evnt&,SUCC(obj&)))
  832.     ELSE                                           ! Sonst ohne...
  833.       popup&=@rsc_popup(FALSE,tree&,next_obj&,obj&,1)
  834.     ENDIF
  835.     '
  836.     IF popup&=0                                    ! Abbruch...
  837.       cont&=1                                      ! ...weiter geht's
  838.       next_obj&=0                                  ! ...Cursor 'festhalten'
  839.     ENDIF
  840.     ' ---------------------------------------------- Cursor positionieren
  841.     ' Möchten Sie den Cursor mit der Maus zeichengenau positionieren?
  842.     ' Dann entREMen Sie diese Zeilen und laden diese Prozedur nach:
  843.     ' ELSE IF BTST(OB_FLAGS(rsc_adr%,next_obj&),3)
  844.     ' rsc_set_cursor(rsc_adr%,mx&,my&,edit_obj&,next_obj&,idx&)
  845.   ENDIF
  846.   '
  847. ENDIF
  848. ENDIF
  849. '
  850. IF cont&=0 OR (next_obj&<>0 AND next_obj&<>edit_obj&)
  851. ~OBJC_EDIT(rsc_adr%,edit_obj&,0,idx&,3,idx&)       ! Ggf. Cursor aus
  852. ENDIF
  853. '
  854. WEND
  855. '
  856. ~GRAF_MOUSE(0,0)                                       ! Zur Sicherheit
  857. '
  858. IF rsc_handle%(tree&)>1000                             ! Normaler Dialog...
  859. ~WIND_UPDATE(0)                                      ! END_UPDATE
  860. ~WIND_UPDATE(2)                                      ! END_MCTRL
  861. ENDIF
  862. '
  863. IF mc&=2 AND BTST(OB_FLAGS(rsc_adr%,next_obj&),6)      ! Doppelklick auf
  864. next_obj&=WORD(BSET(next_obj&,15))                   ! TOUCHEXIT...
  865. ENDIF                                                  ! ...15. Bit setzen
  866. '
  867. rsc_do_ende:
  868. RETURN next_obj&
  869. ENDFUNC
  870. > FUNCTION rsc_popup(a!,tree&,button&,popup&,def&)
  871. $F%
  872. LOCAL x&,y&,b&,h&,m!
  873. LOCAL evnt&,mx&,my&,mb&,shift&,key&,mc&,ascii|,scan|
  874. LOCAL obj&,old_obj&,first&,anz&
  875. LOCAL rsc&,rsc_adr%
  876. '
  877. ' Popup-Menü darstellen und auswerten...
  878. '
  879. ' a!       : TRUE: Button verändern, FALSE: Nur Popup
  880. ' tree&    : Index des Dialogbaumes
  881. ' button&  : Objektnr. des betätigten Buttons
  882. ' popup&   : Index des Popups
  883. ' def&     : Default-Eintrag (1-x)
  884. '
  885. ~WIND_UPDATE(1)                                   ! BEG_UPDATE
  886. ~WIND_UPDATE(3)                                   ! BEG_MCTRL
  887. '
  888. rsc_adr%=rsc_adr%(rsc_popup&)
  889. '
  890. first&=OB_HEAD(rsc_adr%,popup&)                   ! erster Eintrag
  891. anz&=SUB(OB_TAIL(rsc_adr%,popup&),first&)         ! Anzahl Einträge-1
  892. ' ------------------------------------------------- Popup positionieren
  893. ~OBJC_OFFSET(rsc_adr%(tree&),button&,x&,y&)
  894. OB_X(rsc_adr%,0)=SUB(x&,OB_X(rsc_adr%,popup&))
  895. OB_Y(rsc_adr%,0)=MAX(ADD(hchar&,4),MIN(SUB(WORK_OUT(1),4)-OB_H(rsc_adr%,popup&),SUB(y&,MUL(def&,hchar&))))-OB_Y(rsc_adr%,popup&)
  896. '
  897. x&=ADD(OB_X(rsc_adr%,0),PRED(OB_X(rsc_adr%,popup&)))
  898. y&=ADD(OB_Y(rsc_adr%,0),PRED(OB_Y(rsc_adr%,popup&)))
  899. b&=ADD(OB_W(rsc_adr%,popup&),4)
  900. h&=ADD(OB_H(rsc_adr%,popup&),4)
  901. ' -------------------------------------------------
  902. rsc_bitblt(0,0,0,popup_back%,b&,h&,x&,y&,b&,h&,0,0)
  903. '
  904. ~OBJC_DRAW(rsc_adr%,0,7,x&,y&,b&,h&)              ! Popup zeichnen
  905. '
  906. IF a!                                             ! Button verändern...
  907. '
  908. ~GRAF_MOUSE(256,0)                              ! Hidem
  909. V~H=rsc_vh&                                     ! ...Default-Eintrag mit...
  910. GRAPHMODE 2
  911. '
  912. INTIN(0)=8                                      ! ...Häkchen versehen
  913. PTSIN(0)=ADD(x&,DIV(wchar&,2))
  914. PTSIN(1)=y&-DIV(hchar&,6)+MUL(SUCC(def&),hchar&)
  915. VDISYS 8,1,1                                    ! ...v_gtext()
  916. '
  917. GRAPHMODE 1
  918. V~H=-1
  919. ~GRAF_MOUSE(257,0)                              ! Showm
  920. '
  921. ENDIF
  922. '
  923. ~GRAF_MKSTATE(mx&,my&,mb&,shift&)
  924. '
  925. obj&=OBJC_FIND(rsc_adr%,popup&,anz&,mx&,my&)      ! Objekt unter der Maus...
  926. '
  927. IF obj&<=0                                        ! Daneben...
  928. obj&=ADD(first&,def&)                           ! ...Default-Eintrag nehmen
  929. ENDIF
  930. '
  931. old_obj&=obj&
  932. IF (NOT BTST(OB_STATE(rsc_adr%,MAX(0,obj&)),3))   ! Nicht disabled...
  933. ~OBJC_CHANGE(rsc_adr%,obj&,0,x&,y&,b&,h&,BSET(OB_STATE(rsc_adr%,obj&),0),1)
  934. ENDIF                                             ! ...selektieren
  935. '
  936. ~EVNT_TIMER(200)
  937. ~GRAF_MKSTATE(mx&,my&,mb&,shift&)
  938. '
  939. IF mb&=1
  940. m!=TRUE
  941. evnt&=4
  942. ENDIF
  943. '
  944. ' --------------------------------------------------
  945. DO
  946. '
  947. IF NOT m!
  948. evnt&=EVNT_MULTI(&X111,1,1,1,1,mx&,my&,1,1,0,0,0,0,0,0,0,mx&,my&,mb&,shift&,key&,mc&)
  949. ELSE
  950. ~GRAF_MKSTATE(mx&,my&,mb&,shift&)
  951. ENDIF
  952. '
  953. IF BTST(evnt&,0)                                 ! Tastaturereignis...
  954. ascii|=BYTE(key&)
  955. scan|=BYTE(SHR(key&,8))
  956. '                                              ! Noch kein sel. Eintrag...
  957. IF NOT (obj&>=first& AND obj&<=ADD(first&,anz&))
  958. obj&=first&
  959. '
  960. ELSE IF scan|=80                               ! ...Cursor runter
  961. INC obj&
  962. IF obj&>ADD(first&,anz&)
  963.   obj&=first&
  964. ENDIF
  965. '
  966. ELSE IF scan|=72                               ! ...Cursor runter
  967. DEC obj&
  968. IF obj&<first&
  969.   obj&=ADD(first&,anz&)
  970. ENDIF
  971. '
  972. ENDIF
  973. '
  974. ENDIF
  975. '
  976. IF BTST(evnt&,2)                                 ! Mausereignis...
  977. obj&=OBJC_FIND(rsc_adr%,popup&,anz&,mx&,my&)
  978. ENDIF
  979. '                                                ! Alten Eintrag deselekt...
  980. IF obj&<>old_obj&
  981. ~OBJC_CHANGE(rsc_adr%,old_obj&,0,x&,y&,b&,h&,BCLR(OB_STATE(rsc_adr%,old_obj&),0),1)
  982. ENDIF
  983. '                                                ! Im Menü und nicht disabled...
  984. IF (obj&>=first& AND obj&<=ADD(first&,anz&)) AND (NOT BTST(OB_STATE(rsc_adr%,MAX(0,obj&)),3))
  985. ~OBJC_CHANGE(rsc_adr%,obj&,0,x&,y&,b&,h&,BSET(OB_STATE(rsc_adr%,obj&),0),1)
  986. '                                              ! ...neuen selektieren
  987. old_obj&=obj&
  988. rsc&=SUB(obj&,first&)                          ! Rückgabe
  989. ENDIF
  990. '
  991. LOOP UNTIL BTST(evnt&,1) OR (mb&<>1 AND m!) OR ascii|=13 OR ascii|=27 OR scan|=97
  992. ' --------------------------------------------------
  993. rsc_bitblt(popup_back%,b&,h&,0,0,0,0,0,b&,h&,x&,y&)! Hintergrund restaurieren
  994. '
  995. IF rsc&=SUB(obj&,first&) AND scan|<>97 AND ascii|<>27 ! Eintrag ausgewählt...
  996. '
  997. ~OBJC_CHANGE(rsc_adr%,obj&,0,x&,y&,b&,h&,BCLR(OB_STATE(rsc_adr%,obj&),0),0)
  998. '
  999. IF a!                                            ! Button verändern...
  1000. '                                              ! Neuen Text eintragen:
  1001. rsc_text(tree&,button&,@rsc_text$(rsc_popup&,obj&))
  1002. '
  1003. ~OBJC_OFFSET(rsc_adr%(tree&),button&,x&,y&)    ! Button zeichnen
  1004. ~OBJC_DRAW(rsc_adr%(tree&),button&,1,x&,y&,OB_W(rsc_adr%(tree&),button&),OB_H(rsc_adr%(tree&),button&))
  1005. '
  1006. ENDIF
  1007. '
  1008. ELSE                                               ! Daneben => Abbruch...
  1009. ~OBJC_CHANGE(rsc_adr%,old_obj&,0,x&,y&,b&,h&,BCLR(OB_STATE(rsc_adr%,old_obj&),0),0)
  1010. '
  1011. rsc&=-1                                          ! ...Abbruch markieren
  1012. '
  1013. ENDIF
  1014. '
  1015. REPEAT
  1016. ~GRAF_MKSTATE(mx&,my&,mb&,shift&)                ! Mausknopf 'entprellen'
  1017. UNTIL mb&=0
  1018. '
  1019. ~WIND_UPDATE(2)                                    ! END_MCTRL
  1020. ~WIND_UPDATE(0)                                    ! END_UPDATE
  1021. '
  1022. RETURN SUCC(rsc&)
  1023. ENDFUNC
  1024. '
  1025. > PROCEDURE rsc_movedial(tree&,edit_obj&,idx&)
  1026. LOCAL ghost!,x&,y&,a%
  1027. '
  1028. ' Dialogbox bewegen...
  1029. ' Möchten Sie SOLID-Flydials? Dann ersetzen Sie diese Prozedur
  1030. ' durch die entsprechenden aus der EXTENDED.LST-Datei.
  1031. '
  1032. ~GRAF_MKSTATE(x&,x&,x&,y&)
  1033. ghost!=AND(y&,&X1111) OR x&=3                            ! Geisterdials...
  1034. IF ghost!
  1035. rsc_bitblt(rsc_handle%(tree&),rscw&(tree&),rsch&(tree&),0,0,0,0,0,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&))
  1036. ENDIF
  1037. '
  1038. ~GRAF_MOUSE(4,0)                                         ! Bewegen...
  1039. ~GRAF_DRAGBOX(rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&),deskx&,desky&,deskw&,deskh&,x&,y&)
  1040. ~GRAF_MOUSE(0,0)
  1041. '
  1042. IF x&<>rscx&(tree&) OR y&<>rscy&(tree&) OR ghost!        ! Überhaupt bewegt...
  1043. '
  1044. IF NOT ghost!
  1045. a%=MALLOC(@getsize(rscw&(tree&),rsch&(tree&)))       ! Dialog getten
  1046. IF a%                                                ! ...hat geklappt
  1047. rsc_bitblt(0,0,0,a%,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&),0,0)
  1048. ENDIF
  1049. ENDIF
  1050. '                                                      ! Hintergr. restaur.
  1051. rsc_bitblt(rsc_handle%(tree&),rscw&(tree&),rsch&(tree&),0,0,0,0,0,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&))
  1052. '
  1053. rscx&(tree&)=x&                                        ! Neue Position setzen...
  1054. rscy&(tree&)=y&
  1055. '
  1056. OB_X(rsc_adr%(tree&),0)=ADD(x&,3)
  1057. OB_Y(rsc_adr%(tree&),0)=ADD(y&,3)
  1058. '                                                      ! Neuen Hintergr. holen
  1059. rsc_bitblt(0,0,0,rsc_handle%(tree&),rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&),0,0)
  1060. '                                                      ! Dialog hinsetzen...
  1061. IF a%                                                  ! Hintergrund gerettet...
  1062. rsc_bitblt(a%,rscw&(tree&),rsch&(tree&),0,0,0,0,0,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&))
  1063. ~MFREE(a%)
  1064. ELSE                                                   ! Sonst wenigstens...
  1065. ~OBJC_DRAW(rsc_adr%(tree&),0,7,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  1066. IF edit_obj&
  1067. rsc_cursor(rsc_adr%(tree&),edit_obj&,idx&)           ! ...Cursor ein
  1068. ENDIF
  1069. ENDIF
  1070. '
  1071. ENDIF
  1072. '
  1073. RETURN
  1074. > PROCEDURE rsc_message(tree&,message&,x&,y&,w&,h&,edit_obj&,idx&)
  1075. LOCAL a|,ax&,ay&,ab&,ah&,handle&,obj&,rsc_adr%,a%,a$
  1076. '
  1077. ' Wertet ein innerhalb des 'rsc_do' eingetroffenes Message-Ereignis aus...
  1078. '
  1079. handle&=rsc_handle%(tree&)                         ! Fensterhandle des Dialogs
  1080. '
  1081. ~WIND_UPDATE(1)                                    ! BEG_UPDATE
  1082. '
  1083. SELECT message&
  1084. ' --------------------------------------------------------------------------
  1085. CASE 20,21                                         ! WM_REDRAW/WM_TOPPED
  1086. IF message&=20                                   ! WM_REDRAW...
  1087. ' ~GRAF_MOUSE(256,0)                           ! Hidem
  1088. ~WIND_GET(handle&,11,ax&,ay&,ab&,ah&)          ! 1. Rechteck
  1089. '
  1090. REPEAT
  1091. '
  1092. IF RC_INTERSECT(x&,y&,w&,h&,ax&,ay&,ab&,ah&) ! ...redrawen
  1093.   ~OBJC_DRAW(rsc_adr%(tree&),0,7,ax&,ay&,ab&,ah&)
  1094. ENDIF
  1095. '
  1096. ~WIND_GET(handle&,12,ax&,ay&,ab&,ah&)        ! Nächstes Rechteck...
  1097. UNTIL ab&=0 AND ah&=0                          ! ...kein Redraw mehr nötig
  1098. '
  1099. ' ~GRAF_MOUSE(257,0)                           ! Showm
  1100. '
  1101. ELSE                                             ! WM_TOPPED...
  1102. ~WIND_SET(handle&,10,0,0,0,0)                  ! ...toppen
  1103. ENDIF
  1104. '
  1105. ~WIND_GET(0,10,ax&,ay&,ay&,ay&)                  ! Oberstes Fenster...
  1106. IF ax&=handle& AND edit_obj&>0                   ! Ist das unsrige...
  1107. ' ---------------------------------------------- Cursor-Setz-Orgie...
  1108. rsc_adr%=rsc_adr%(tree&)
  1109. '
  1110. obj&=edit_obj&                                 ! Parent ermitteln...
  1111. '
  1112. REPEAT
  1113. obj&=OB_NEXT(rsc_adr%,obj&)
  1114. UNTIL obj&<edit_obj&
  1115. '
  1116. ~OBJC_OFFSET(rsc_adr%,edit_obj&,ax&,ay&)       ! Koordinaten des Objekts
  1117. '
  1118. a$=CHAR{{ADD(OB_SPEC(rsc_adr%,edit_obj&),4)}}  ! Maske: "Eingabe:______"
  1119. ah&=1
  1120. WHILE MID$(a$,ah&,1)<>"_"                      ! Länge des Vortextes...
  1121. INC ah&
  1122. WEND                                           ! ...ermitteln
  1123. '
  1124. ADD ax&,MUL(wchar&,ADD(PRED(ah&),idx&))        ! Cursor-Position im Pixeln
  1125. ah&=ADD(OB_H(rsc_adr%,edit_obj&),6)            ! Cursor ist größer hchar&
  1126. '                                              ! Cursor löschen...
  1127. ~OBJC_DRAW(rsc_adr%,obj&,7,ax&,SUB(ay&,3),wchar&,ah&)
  1128. rsc_cursor(rsc_adr%,edit_obj&,idx&)            ! ...und setzen
  1129. '
  1130. ENDIF
  1131. ' --------------------------------------------------------------------------
  1132. CASE 28                                            ! WM_MOVED
  1133. ~WIND_CALC(1,&X1001,x&,y&,w&,h&,ax&,ay&,ab&,ah&)
  1134. '
  1135. rscx&(tree&)=PRED(ax&)
  1136. rscy&(tree&)=SUB(SUB(ay&,5),MUL(hchar&,2))
  1137. OB_X(rsc_adr%(tree&),0)=ADD(rscx&(tree&),3)
  1138. OB_Y(rsc_adr%(tree&),0)=ADD(rscy&(tree&),3)
  1139. '
  1140. ~WIND_SET(handle&,5,x&,y&,w&,h&)
  1141. '
  1142. ENDSELECT
  1143. '
  1144. ~WIND_UPDATE(0)                                    ! END_UPDATE
  1145. '
  1146. RETURN
  1147. '
  1148. > PROCEDURE rsc_back(tree&)
  1149. '
  1150. ' Entfernt den Dialog vom Bildschirm...
  1151. '
  1152. ' ---------------------------------------------------- Als Fenster-Dialog
  1153. IF rsc_handle%(tree&)>0 AND rsc_handle%(tree&)<1000
  1154. '
  1155. ~WIND_UPDATE(1)                                    ! BEG_UPDATE
  1156. '
  1157. rsc_menu_ienable(TRUE)                             ! ...Menü wieder wählbar
  1158. '
  1159. IF rsc_window&                                     ! Fenster existiert...
  1160. '
  1161. ~WIND_CLOSE(rsc_handle%(tree&))
  1162. ~WIND_DELETE(rsc_handle%(tree&))                 ! ...schließen & abmelden
  1163. '
  1164. DEC rsc_window&                                  ! Anz. offene Fenster-1
  1165. '
  1166. ELSE                                               ! Sonst Redraw auslösen...
  1167. ~FORM_DIAL(3,0,0,0,0,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  1168. ENDIF
  1169. ' -------------------------------------------------- Als normaler Dialog
  1170. ELSE
  1171. rsc_list$=LEFT$(rsc_list$,SUB(LEN(rsc_list$),2))   ! Dialog aus der Liste entf.
  1172. '
  1173. IF rsc_handle%(tree&)                              ! Hintergrund gerettet...
  1174. rsc_bitblt(rsc_handle%(tree&),rscw&(tree&),rsch&(tree&),0,0,0,0,0,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&))
  1175. ~MFREE(rsc_handle%(tree&))
  1176. '
  1177. ELSE                                               ! Desktop redrawen...
  1178. ~FORM_DIAL(3,0,0,0,0,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  1179. IF rsc_list$<>""                                 ! Noch ein Dialog drunter...
  1180. ~OBJC_DRAW(rsc_adr%(CVI(RIGHT$(rsc_list$,2))),0,7,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  1181. ENDIF                                            ! ...diesen auch redrawen
  1182. ENDIF
  1183. ENDIF
  1184. '
  1185. rsc_handle%(tree&)=0
  1186. '
  1187. ~WIND_UPDATE(0)                                      ! END_UPDATE
  1188. '
  1189. RETURN
  1190. '
  1191. > PROCEDURE rsc_text(tree&,obj&,a$)
  1192. '
  1193. ' Universelle Objekt-Text Belegung...
  1194. '
  1195. CHAR{C:rsc_obspec%(L:rsc_adr%(tree&),obj&)}=a$
  1196. RETURN
  1197. > PROCEDURE rsc_bitblt(a%,w&,h&,b%,rb&,rh&,ax&,ay&,ab&,ah&,gx&,gy&)
  1198. '
  1199. ' Universeller Raster-Kopierer (benutzt vro_cpyfm oder vrt_cpyfm)...
  1200. '
  1201. IF ab&>0 AND ah&>0                 ! Breite und Höhe vorhanden...
  1202. '
  1203. ~GRAF_MOUSE(256,0)               ! Hidem
  1204. ~C:rsc_bitblt%(L:a%,w&,h&,0,planes&,L:b%,rb&,rh&,0,planes&,ax&,ay&,ab&,ah&,gx&,gy&,1)
  1205. ~GRAF_MOUSE(257,0)               ! Showm
  1206. '
  1207. ENDIF
  1208. '
  1209. RETURN
  1210. > PROCEDURE rsc_cursor(rsc_adr%,edit_obj&,idx&)
  1211. LOCAL a|,a%
  1212. '
  1213. ' Zeichengenaue Positionierung des Cursors...
  1214. '
  1215. a%=ADD({OB_SPEC(rsc_adr%,edit_obj&)},idx&)
  1216. '
  1217. a|=BYTE{a%}                                        ! Zeichen merken
  1218. BYTE{a%}=0                                         ! ...und durch 0 ersetzen
  1219. '
  1220. ~OBJC_EDIT(rsc_adr%,edit_obj&,0,idx&,1,idx&)       ! Cursor setzen
  1221. BYTE{a%}=a|                                        ! ...Zeichen restaurieren
  1222. '
  1223. RETURN
  1224. ' ------------------------------------------------------------------------------
  1225. > PROCEDURE rsc_zuweisungen(trees&)
  1226. '
  1227. ' Diese Prozedur wird nur für das Demoprogramm benötigt!
  1228. '
  1229. ' Fenstertitel...
  1230. INLINE wt%,23
  1231. '
  1232. ' Objektnummern des Beispieldialoges...
  1233. flags|=0
  1234. '
  1235. ' help|=25
  1236. abbruch|=26
  1237. ok|=27
  1238. '
  1239. popup|=1
  1240. '
  1241. menu|=2
  1242. m_about|=8
  1243. m_new|=17
  1244. ' m_open|=18
  1245. m_quit|=23
  1246. m_dialog|=25
  1247. m_fenster|=26
  1248. m_fensterc|=27
  1249. '
  1250. RETURN
  1251.